##### Carregando pacotes -------
library(ggplot2) # Gráficos
library(ggthemes) # Temas ggplot
library(plotly) # Plots dinâmicos
library(astsa) # Arima; Série de desemprego (unemp)
library(purrr) # importa %>%
library(xts) # Objeto zoo e xts
library(lubridate) # Para eixos
library(readxl) # Lida melhor com excel
library(RColorBrewer) # Consultar
library(lattice) # Consultar
library(grid) # Consultar
library(gridExtra) # Consultar
library(gtable) # Consultar
library(magick) # Para ler imagem. ATENÇÂO INSTALAÇÂO
library(rmarkdown) # Make cool dynamic documents [Necessário?]
library(knitr) # Run R Code Chunks [Necessário?]
library(DT) # Interactive HTML tables
library(d3heatmap) # biblioteca para construir heatmaps
library(colorRamps)# Ajuda com heatmaps e cores
# Pacotes para dados brasileiros -----------------------
library(BETS)
library(rbcb) # Banco Central
library(ecoseries) #BC ipeadata e SIDRA
library(ribge) # IBGE
# Pacotes para dados internacionais -----------------------
library(imfr) #para pegar series do site do FMI
ajuste_xts <- function(dados,
col_data = 1,
col_dados = 2,
remover_NA = FALSE){
if ("xts" %in% class(dados)
| "zoo" %in% class(dados)) {
message("Série está em xts/zoo, função ajuste_xts não necessária")
if (sum(is.na(dados)) != 0 & remover_NA == FALSE) {
message("Séries contém NAs, use remover_NA = TRUE", call. = FALSE)
}
if (remover_NA == FALSE) {
xts(x = coredata(dados),
order.by = as.Date(index(dados)))
} else {
sem_NA <- !is.na(coredata(dados))
xts(x = coredata(dados[sem_NA]),
order.by = as.Date(index(dados[sem_NA])))
}
} else if ("ts" %in% class(dados)) {
dados <- as.xts(dados)
}
else {
if (sum(is.na(dados)) != 0 & remover_NA == FALSE) {
message("Séries contém NAs, use remover_NA = TRUE", call. = FALSE)
}
if (remover_NA == TRUE) {
teste_NA <- !(is.na(dados[, col_dados]))
dados_sNA <- dados[teste_NA,]
proxy <- as.data.frame(dados_sNA)
proxy_data <- as.Date(proxy[, col_data], origin = proxy[1, col_data])
xts(x = proxy[, col_dados],
order.by = proxy_data)
} else{
proxy <- as.data.frame(dados)
proxy_data <- as.Date(proxy[ , col_data], origin = proxy[1,col_data])
xts(x = proxy[, col_dados],
order.by = proxy_data)
}
}
}
Exemplo:
dado_excel <- read_xlsx("../../Brutos/ativ_econ.xlsx", sheet = "IBCBr")
dado_excel_ajustado <- ajuste_xts(dado_excel)
## Séries contém NAs, use remover_NA = TRUEFALSE
head(dado_excel_ajustado, n = 13)
## [,1]
## 2002-02-01 NA
## 2002-03-01 NA
## 2002-04-01 NA
## 2002-05-01 NA
## 2002-06-01 NA
## 2002-07-01 NA
## 2002-08-01 NA
## 2002-09-01 NA
## 2002-10-01 NA
## 2002-11-01 NA
## 2002-12-01 NA
## 2003-01-01 100.42
## 2003-02-01 101.87
dado_excel_sNA <- ajuste_xts(dado_excel, remover_NA = TRUE)
head(dado_excel_sNA)
## [,1]
## 2003-01-01 100.42
## 2003-02-01 101.87
## 2003-03-01 102.23
## 2003-04-01 101.13
## 2003-05-01 99.68
## 2003-06-01 100.40
class(dado_excel_sNA)
## [1] "xts" "zoo"
head(ajuste_xts(dado_excel_sNA))
## Série está em xts/zoo, função ajuste_xts não necessária
## [,1]
## 2003-01-01 100.42
## 2003-02-01 101.87
## 2003-03-01 102.23
## 2003-04-01 101.13
## 2003-05-01 99.68
## 2003-06-01 100.40
Atenção:
clean_ipeadata <- function(dado_ipea) {
dado_desl <- unlist(dado_ipea)
valor <- dado_desl[((length(dado_desl)/2) + 1):length(dado_desl)]
data_ipea <- dado_desl[1:(length(dado_desl)/2)]
data_clean <- as.Date(data_ipea)
xts_name <- deparse((substitute(dado_ipea)))
xts(x = valor, order.by = data_clean)
}
Exemplo:
[EM ABERTO]
Atenção:
exportar_dados <- function(dados,
pasta = "../Tratados", # Se não estiver na mesma pasta, "../Pasta"
formato = ".RData") {
nome_dado <- deparse(substitute(dados))
nome_arquivo <- paste0(nome_dado,formato)
caminho <- file.path(pasta, nome_arquivo)
saveRDS(dados,
file = caminho)
}
Exemplo:
exportar_dados(dado_excel_ajustado,
pasta = "./Temp/")
OBS: Para gráficos, usar ggplot
MM12m <- function(x) {
y <- c(1:(length(x))) #cria variavel y to tamanho da serie inserida
for(i in 1:(length(x)-11)) { #para i vezes menos 12
y[i+11]<-mean(x[(i+0):(i+11)]) #faz média de 12 passos
}
y[1:12]<-NA #coloca NA nas primeiras 12 entradas
return(y) #dá como retorno a série media movel 12 meses
}
Exemplo:
unemp_MM12m <- MM12m(unemp)
plot.ts(unemp_MM12m)
Sugestões de mudanças:
OBS: Para gráficos, usar ggplot
media_movel <- function(dados,
digitos = 2,
meses = 12,
tabela = FALSE) {
if ("ts" %in% class(dados)) { # Inicia checagem
dados <- as.xts(dados)
}
else if ("tbl_df" %in% class(dados) |
"tbl" %in% class(dados)) {
stop("Usar ajuste_xts", call. = FALSE)
}
else if ("xts" %in% class(dados) |
"zoo" %in% class(dados)) {
dados <- dados
}
else {
stop("Usar ajuste_xts", call. = FALSE)
} # Inicia operacao
y <- c(1:(length(dados))) #cria variavel y to tamanho da serie inserida
for (i in 1:(length(dados) - (meses - 1))) { #para i vezes menos meses
y[i + (meses - 1)] <- mean(dados[(i + 0):(i + (meses - 1))]) #faz média de meses passos
}
y[1:meses] <- NA #coloca NA nas primeiras 12 entradas
if (tabela == FALSE) {
mm_xts <- xts(x = y,
order.by = as.Date(index(dados)))
return(mm_xts)
} else {
mm_xts <- xts(x = y,
order.by = as.Date(index(dados)))
Tabela_mm <- merge.xts(x = dados,
y = mm_xts)
# serie <- deparse(substitute(dados)) # TODO
# colnames(Tabela_mm) <- c(as.character(serie), "Media_Movel")
return(Tabela_mm)
}
}
unemp_media12 <- media_movel(unemp)
head(unemp_media12)
## [,1]
## 1948-01-01 NA
## 1948-02-01 NA
## 1948-03-01 NA
## 1948-04-01 NA
## 1948-05-01 NA
## 1948-06-01 NA
unemp_media12T <- media_movel(unemp, tabela = TRUE)
head(unemp_media12T, n = 13)
## x y
## jan 1948 235.1 NA
## fev 1948 280.7 NA
## mar 1948 264.6 NA
## abr 1948 240.7 NA
## mai 1948 201.4 NA
## jun 1948 240.8 NA
## jul 1948 241.1 NA
## ago 1948 223.8 NA
## set 1948 206.1 NA
## out 1948 174.7 NA
## nov 1948 203.3 NA
## dez 1948 220.5 NA
## jan 1949 299.5 233.1
unemp_media4 <- media_movel(unemp, meses = 4)
head(unemp_media4)
## [,1]
## 1948-01-01 NA
## 1948-02-01 NA
## 1948-03-01 NA
## 1948-04-01 NA
## 1948-05-01 246.850
## 1948-06-01 236.875
Atenção:
# tx_acum <- function(dados,
# digitos = 2,
# meses = 12,
# tabela = FALSE) {
# if ("ts" %in% class(dados)) { # Inicio checagem
# dados <- as.xts(dados)
# }
# else if ("tbl_df" %in% class(dados) |
# "tbl" %in% class(dados)) {
# stop("Usar ajuste_xts", call. = FALSE)
# }
# else if ("xts" %in% class(dados) |
# "zoo" %in% class(dados)) {
# dados <- dados
# }
# else {
# stop("Usar ajuste_xts", call. = FALSE)
# } # Inicio Operacao
# m <- c(1:(length(dados))) #cria variavel m to tamanho da serie inserida
# for (i in 1:(length(dados) - (meses - 1))) {#para o total tamanho de x vezes, menos 12
# k <- 1 #cria a var K iterada para chegar na serie m
# for (j in 0:(meses - 1)) { #meses vezes para se taxa anualizada
# k <- k * (1 + dados[i - j + (meses - 1)]/100) #faz multiplica??o de 12 passos para cada posi??o i
# }
# k <- (k - 1)*100#retira 1 finalmente para ficar em valor porcentual
# }
# m[i + (meses - 1)] <- k
# m[1:(meses - 1)] <- NA #coloca NA nas primeiras 12 entradas
# return(m)
# if (tabela == FALSE) { # Inicio tabela
# acum_xts <- xts(x = k,
# order.by = as.Date(index(dados)))
# return(acum_xts)
# } else {
# acum_xts <- xts(x = k,
# order.by = as.Date(index(dados)))
# Tabela_accum <- merge.xts(x = dados,
# y = acum_xts)
# return(Tabela_accum)
# }
# }
# teste_acum <- tx_acum(UnempRate) # TODO
grafico_padrao <- function(dado_xts,
tipo_grafico = geom_line(size = 1),
titulo = NULL,
fonte = NULL,
x_titulo = NULL,
y_titulo = NULL,
tema = theme_classic(),
quebra_data = "1 year",
label_data = "%Y",
pontos = 0){
dado_xts <- as.xts(dado_xts)
ggplot(data = dado_xts,
aes(
x = as.Date(index(dado_xts)),
y = coredata(dado_xts))) +
tipo_grafico +
labs(x = x_titulo,
y = y_titulo,
title = titulo,
caption = paste0("Fonte: ", fonte)) +
tema +
theme(panel.border = element_blank(),
axis.line = element_line(colour = "black",
size = 0.7),
axis.text.x = element_text(angle = 90,
hjust = 0,
vjust = 0.5,
size = 14),
axis.text.y = element_text(angle = 0,
hjust = 0,
vjust = 0.5,
size = 14),
text = element_text(size = 10,
family = "TT Times New Roman")) +
scale_x_date(date_breaks = quebra_data, date_labels = label_data) +
geom_point(size = pontos)
}
Exemplo:
Plot_Simples <- grafico_padrao(unemp)
Plot_Simples
Plot_Formatado <- grafico_padrao(dado_xts = unemp,
titulo = "Desemprego nos EUA (1947-1980)",
x_titulo = "Ano",
y_titulo = "Desempregados (mil)",
quebra_data = "5 years",
label_data = "%Y",
tema = theme_economist_white(),
fonte = "Pacote astsa")
Plot_Formatado
Sugestões de mudança:
O logo do cecon será salvo em um objeto para agilizar a compilação:
#logo_cecon <- image_read("http://i.imgur.com/2e3FQaz.png")
#logo_cecon
add_logo <- function(grafico = last_plot()){
grafico %>%
ggplotly() %>%
layout(images = list(list(source = "http://i.imgur.com/2e3FQaz.png",
xref = "paper",
yref = "paper",
x= 0.02,
y= 1,
sizex = 0.25,
sizey = 0.25,
opacity = 0.5))) %>%
config(displayModeBar = TRUE)
}
Exemplo:
teste <- grafico_padrao(unemp)
teste_logo <- add_logo(teste)
teste_logo
Atenção:
grafico_cecon <- function(dado_xts,
logo = TRUE,
FUN = grafico_padrao){
grafico <- dado_xts %>% FUN()
if (logo == TRUE) {
grafico_logo <- grafico %>% add_logo()
return(grafico_logo)
# if (is.null(transform) == FALSE ) {
# grafico_logo %>% add_fun(transform)
# }
#
# else {
# return(grafico_logo)
# }
} else {
return(grafico)
}
}
Exemplo:
grafico_cecon(unemp)
Sugestões de mudanças:
Ideia é gerar um gráfico pronto para uso a partir de dados brutos e em poucas linhas de código. A implementação é pensada nas rotinas não focadas na geração de gráficos. No momento, só é possível plotar uma série por vez.
grafico_rapido <- function(dado,
remover_NA = FALSE){
grafico <- dado %>%
ajuste_xts(remover_NA = remover_NA) %>%
grafico_padrao %>%
add_logo
return(grafico) }
Exemplo:
grafico_rapido(dado_excel, remover_NA = TRUE)
#grafico_rapido(unemp_media12T) # Adicionar para mais de uma série
salvar_grafico <- function(grafico, pasta, formato = ".png"){
nome_grafico <- deparse(substitute(grafico))
salvar_nome <- paste0(Sys.Date(),"_",nome_grafico,formato)
ggsave(file.path(pasta, salvar_nome))
}
Exemplo:
Consultar pasta Temp
salvar_grafico(grafico = Plot_Formatado,
pasta = 'Temp')
## Saving 7 x 5 in image
Sugestão de modificações:
Cria uma função que retorna texto “positivo” “negativo” dependendo se acima ou abaixo de z
FazTexto.Cortes1 <- function(x, # Série a ser analisada
z, # fronteira
y){ # Se feminino, y=1. Se masculino, y=2.
if (x >= z & y == 1) {k <- "positiva"}
if (x >= z & y == 2) {k <- "positivo"}
if (x < z & y == 1) {k <- "negativa"}
if (x < z & y == 2) {k <- "negativo"}
return(k)
}
Exemplo:
[EM ABERTO]
Sugestões de mudança:
Cria uma função que retorna texto “muito ruim”, “ruim”, “bom”, “muito bom”.
FazTexto.Cortes3 <- function(x, # Séria a ser analisada
y, # Corte 1
z, # Corte 2
w # Corte 3
){
k <- "muito ruim"
if (x > y) {k <- "ruim"}
if (x > z) {k <- "bom"}
if (x > w) {k <- "muito bom"}
return(k)
}
Exemplo:
[EM ABERTO]
Sugestões de mudanças:
Dúvidas:
Cria uma função que retorna o ultimo valor de uma série x.
FazTexto.UltimoValor <- function(x, # Série a ser analisada
digitos = 2){
k <- format(round(x[length(x)],
digits = digitos),
big.mark = ".",
decimal.mark = ",")
return(k)
}
Exemplo:
Sugestões de mudanças:
Mudanças:
Cria uma função que retorna o valor 12 meses anteriores de uma série mensal x:
FazTexto.Valor12mAntes <- function(x, # Série a ser analisada
digitos = 2){
k <- format(round(x[length(x) - 11],
digits = digitos),
big.mark = ".",
decimal.mark = ",")
return(k)
}
Exemplo:
Mudanças:
Sugestões:
Expande função 12 meses anteriores para qualquer número (12 padrão):
FazTexto.ValorMesAntes <- function(x, # Série a ser analisada
digitos = 2,
meses = 12){
k <- format(round(x[length(x) - (meses - 1)],
digits = digitos),
big.mark = ".",
decimal.mark = ",")
return(k)
}
Exemplo:
Cria uma função que retorna a variação absoluta (em pontos percentuais se ja for uma série percental) de uma série no ultimo ano:
FazTexto.Var12m.Abs <- function(x, # Série a ser analisada
digitos = 2){
k <- format(round(x[length(x)] - x[length(x) - 11], #subtrai o ultimo valor da série x de 12 meses anteriores
digits = digitos),
big.mark = ".",
decimal.mark = ",")
return(k)
}
Exemplo:
Mudanças:
Sugestões de mudanças:
Cria uma função que retorna a variação em pontos percentuais de uma série no ultimos dois anos:
FazTexto.Var24m.Abs <- function(x,y){#x é a séria a ser análisada, y o número de digitos da saida
k=format(round(x[length(x)]-x[length(x)-23],digits = y), big.mark=".", decimal.mark=",") #subtrai o ultimo valor da série x de 24 meses anteriores
return(k)
}
FazTexto.VarMes.Abs <- function(x, # Série a ser analisada
digitos = 2,
meses = 12){
k <- format(round(x[length(x)] - x[length(x) - (meses - 1)], #subtrai o ultimo valor da série x de meses meses anteriores
digits = digitos),
big.mark = ".",
decimal.mark = ",")
return(k)
}
Exemplo:
Cria uma função que retorna a variação percentuais de uma série no ultimo ano
FazTexto.Var12m.porc <- function(x, # Série a ser analisada
digitos = 2){
k <- format(round((((x[length(x)]/x[length(x) - 11]) - 1)*100), #divide o ultimo valor da série x de 12 meses anteriores
digits = digitos),
big.mark = ".",
decimal.mark = ",")
return(k)
}
Exemplo:
Mudanças:
Sugestões de mudanças:
Cria uma função que retorna a variação percentuais de uma série nos ultimos 2 anoa
FazTexto.Var24m.porc <- function(x,y){#x é a séria a ser análisada, y o número de digitos da saida
k=format(round((((x[length(x)]/x[length(x)-23])-1)*100),digits = y), big.mark=".", decimal.mark=",") #divide o ultimo valor da série x de 24 meses anteriores
return(k)
}
Cria uma função que retorna a variação percentuais de uma série nos último n meses
FazTexto.VarMes.porc <- function(x, # Série a ser analisada
digitos = 2,
meses = 12){
k <- format(round((((x[length(x)]/x[length(x) - (meses - 1)]) - 1)*100), #divide o ultimo valor da série x de meses meses anteriores
digits = digitos),
big.mark = ".",
decimal.mark = ",")
return(k)
}
Exemplo:
Cria função para taxa anualizado (eleva a 12 potência)(ex. IPCA=2,33)
FazTexto.TaxaAnualizada <- function(x){#x é a séria a ser análisada
k <- c(1:length(x))
for (i in 0:length(x)) {
k[i] <- (1 + x[i]/100)^12
}
k <- (k - 1)*100
return(k)
}
Exemplo:
[EM ABERTO]
Sugestões de mudança:
Dúvidas:
Cria função para acumulado em 12 meses
FazTexto.Acc12m <- function(x,
digitos = 2){
k <- 0
for (i in 0:11) { #para i vezes menos 12
k <- k + x[length(x) - i] #faz soma de 12 passos
}
k <- format(round(k, digits = digitos),
big.mark = ".",
decimal.mark = ",") #arredonda para y digitos
return(k)
}
Exemplo:
Mudanças:
Sugestões de mudanças:
Cria função para acumulado em m meses
FazTexto.AccMes <- function(x,
digitos = 2,
meses = 12){
k <- 0
for (i in 0:(meses - 1)) { #para i vezes menos meses
k <- k + x[length(x) - i] #faz soma de 12 passos
}
k <- format(round(k, digits = digitos),
big.mark = ".",
decimal.mark = ",")
return(k)
}
Exemplo:
FazTexto.TaxaAcc12m <- function(x){#x ? a s?ria a ser an?lisada
m <- c(1:(length(x))) #cria variavel m to tamanho da serie inserida
for (i in 1:(length(x) - 11)) { #para o total tamanho de x vezes, menos 12
k <- 1 #cria a var K iterada para chegar na seria m
for (j in 0:11) {#12 vezes para se taxa anualizada
k <- k * (1 + x[(i - j) + 11]/100) #faz multiplica??o de 12 passos para cada posi??o i
}
k <- (k - 1)*100 #retira 1 finalmente para ficar em valor porcentual
m[i + 11] <- k
}
m[1:11] <- NA #coloca NA nas primeiras 12 entradas
return(m) #d? como retorno a s?rie taxa anualizada
}
Exemplo:
FazTexto.TaxaAccMeses <- function(x,
meses = 12){#x ? a s?ria a ser an?lisada
m <- c(1:(length(x))) #cria variavel m to tamanho da serie inserida
for (i in 1:(length(x) (meses - 1))) { #para o total tamanho de x vezes, menos 12
k <- 1 #cria a var K iterada para chegar na seria m
for (j in 0:(meses - 1)) {#12 vezes para se taxa anualizada
k <- k * (1 + x[(i - j) + (meses - 1)]/100) #faz multiplica??o de 12 passos para cada posi??o i
}
k <- (k - 1)*100 #retira 1 finalmente para ficar em valor porcentual
m[i + (meses - 1)] <- k
}
m[1:(meses - 1)] <- NA #coloca NA nas primeiras 12 entradas
return(m) #d? como retorno a s?rie taxa anualizada
}
Cria função para criar número indice de uma série mensal de inflação (para usar em deflacionamentos até para a ultima data)
FazTexto.N_Indice <- function(x){#x é a séria a ser análisada
k <- c(1:length(x)) #retorna o numero indice para deflacionar para o ultimo valor do ipca
k[1] <- (1 + x[1]/100)
for (i in 2:length(x)) {
k[i] <- (1 + x[i]/100)*k[i - 1]
}
k <- k[length(k)/k]
return(k)
}
Exemplo:
[EM ABERTO]
Dúvidas:
# saveRDS(object = add_logo,
# file = "Funcoes.R")